Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue24/survive/FMPYMT.PAS

Pascal/Delphi Source File | 1997-06-23 | 6.4 KB | 244 lines

unit fmpymt;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DBGrids, DB, MultGrid, Mask,
  fmAllo;

type
  TfrmPayment = class(TForm)
    grpOutstandingCredits: TGroupBox;
    grpPayment: TGroupBox;
    grdPayment: TStringGrid;
    grpTotals: TGroupBox;
    edtTotalToPay: TEdit;
    edtTotalPaid: TEdit;
    edtBalanceDue: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    btnPost: TButton;
    btnCancel: TButton;
    dsCreditsOut: TDataSource;
    btnAllocation: TButton;
    grdCredits: TDBMultiGrid;
    btnSelectAll: TButton;
    btnClearAll: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure grdCreditsSelected(Sender: TObject);
    procedure grdPaymentSetEditText(Sender: TObject; ACol, ARow: Longint;
      const Value: string);
    procedure btnSelectAllClick(Sender: TObject);
    procedure btnClearAllClick(Sender: TObject);
    procedure btnAllocationClick(Sender: TObject);
    procedure btnPostClick(Sender: TObject);
  private
  public
    CustomerNo: LongInt;
    TotalToPay,
    TotalPaid,
    BalanceDue: Double;

    procedure PopulateForm;
    procedure UpdateTotals;
  end;

var
  frmPayment: TfrmPayment;

function ShowCreditPaymentDlg(aCustomerNo: LongInt): TModalResult;

implementation

{$R *.DFM}

uses
  uBase, dmData;

function ShowCreditPaymentDlg(aCustomerNo: LongInt): TModalResult;
begin
(*
  Application.CreateForm(TfrmPayment, frmPayment);
  try
*)
    with frmPayment do begin
      CustomerNo := aCustomerNo;
      PopulateForm;
      Result := ShowModal;
    end;
(*
  finally
    frmPayment.Release;
  end;
*)
end;

procedure TfrmPayment.PopulateForm;
var
  I: Integer;
begin
  UpdateTotals;

  { Show the outstanding credits for this customer }
  with dmDataModule.qryCreditsOutByCustomer do begin
    ParamByName('CustNo').AsInteger := CustomerNo;
    Open;
  end;

  { Setup the payment method grid }
  with grdPayment do begin
    Cells[0, 0] := 'Method';
    Cells[1, 0] := 'Amount';
    with dmDataModule.PaymentMethodsList do begin
      RowCount := Count + 1;
      for I := 0 to Count - 1 do
        Cells[0, I + 1] := Strings[I];
    end;
  end;
end;

procedure TfrmPayment.UpdateTotals;
begin
  if TotalToPay = 0 then
    BalanceDue := 0
  else
    BalanceDue := TotalToPay - TotalPaid;

  edtTotalToPay.Text := Format(mskCurrency, [TotalToPay]);
  edtTotalPaid.Text := Format(mskCurrency, [TotalPaid]);
  edtBalanceDue.Text := Format(mskCurrency, [BalanceDue]);
  if BalanceDue < 0 then
    edtBalanceDue.Color := clRed
  else
    edtBalanceDue.Color := TGroupBox(edtBalanceDue.Parent).Color;
end;

procedure TfrmPayment.FormDestroy(Sender: TObject);
begin
  dmDataModule.qryCreditsOutByCustomer.Close;
end;

procedure TfrmPayment.btnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmPayment.grdCreditsSelected(Sender: TObject);
var
  DeltaAmount: LongInt;
begin
(*  if PaymentAllocation.Allocated then PaymentDeallocated := True;*)

  { Adjust the total "Credits to Pay" }
  DeltaAmount := dmDataModule.qryCreditsOutByCustomer.FieldByName('BalanceDue').AsInteger;
  if not grdCredits.Selected then DeltaAmount := -DeltaAmount;
  TotalToPay := TotalToPay + DeltaAmount;
  UpdateTotals;

  { Add the credit to the allocation data }
  with dmDataModule.qryCreditsOutByCustomer do
    if grdCredits.Selected then
      frmPaymentAllocation.AddCredit(FieldByName('CreditNo').AsInteger,
                                     Trunc(FieldByName('BalanceDue').AsFloat))
    else
      frmPaymentAllocation.DeleteCredit(FieldByName('CreditNo').AsInteger);
end;

procedure TfrmPayment.grdPaymentSetEditText(Sender: TObject; ACol,
  ARow: Longint; const Value: string);
var
  I: Integer;
begin

  { Update total payment amount }
  TotalPaid := 0;
  with grdPayment do begin
    for I := 1 to RowCount - 1 do
      if Cells[1, I] <> '' then
        TotalPaid := TotalPaid + StrToFloat(Cells[1, I]);
  end;

  UpdateTotals;  { Change the display }
end;

procedure TfrmPayment.btnSelectAllClick(Sender: TObject);
begin
  grdCredits.SelectAll(True);
end;

procedure TfrmPayment.btnClearAllClick(Sender: TObject);
begin
  grdCredits.SelectAll(False);
end;

procedure TfrmPayment.btnAllocationClick(Sender: TObject);
begin
  ShowPaymentAllocationDlg;
end;

procedure TfrmPayment.btnPostClick(Sender: TObject);
var
  PaymentNo: LongInt;
  Amount,
  TotalPaidThisCredit: LongInt;
  C, P: Integer;
begin
  with dmDataModule.dbDemo do begin
    StartTransaction;
    try

      { post the main payment record }
      with dmDataModule.spPaymentSave do begin
        ParamByName('iCustNo').AsInteger := CustomerNo;
        ParamByName('iAmount').AsFloat := TotalPaid;
        ExecProc;
        PaymentNo := ParamByName('oPaymentNo').AsInteger;
      end;

      { Post the payment amounts at finest granularity }
      with frmPaymentAllocation do begin
        with grdCredits do begin

          { for each credit selected to pay }
          for C := FixedRows to RowCount - 1 do begin
            TotalPaidThisCredit := 0;

            { for each payment method for that credit }
            for P := FixedCols to ColCount - 1 do begin
              Amount := GetCellAmount(Cells[P, C]);
              if Amount <> 0 then
                with dmDataModule.qryPaymentAllocSave do begin
                  ParamByName('PaymentNo').AsInteger := PaymentNo;
                  ParamByName('CreditNo').AsInteger := LongInt(Credits[C - FixedRows]);
                  ParamByName('PayMethodCode').AsString :=
                    PChar(dmDataModule.PaymentMethodsList.Objects[P - FixedCols]);
                  ParamByName('Amount').AsFloat := Amount;
                  Inc(TotalPaidThisCredit, Amount);
                  ExecSQL;
                end;
            end;

            if TotalPaidThisCredit <> 0 then
              with dmDataModule.spPaymentCreditSave do begin
                ParamByName('iPaymentNo').AsInteger := PaymentNo;
                ParamByName('iCreditNo').AsInteger := LongInt(Credits[C - FixedRows]);
                ParamByName('iAmount').AsFloat := TotalPaidThisCredit;
                ExecProc;
              end;
          end;
        end;
      end;

      Commit;
    except
      Rollback;
      raise;
    end;
  end;
end;

end.